﻿Module Module1

    ''' <summary>
    ''' Used to enable or disable Log Timestamps by default
    ''' </summary>
    ''' <remarks></remarks>
    Public Const EnableTimeStampsByDefault As Boolean = True

    Public Property Verbose As Boolean = False
    Public Property InputFilename As String = ""
    Public Property OutputPath As String = ""
    Public Property PrintHelpOnly = False
    Public Property OutputFilter = "*"
    Public Property RecursiveQuery = True

    ''' <summary>
    ''' Adds text to the Console Window
    ''' </summary>
    ''' <param name="text">Text to be added</param>
    ''' <param name="leaveOpen">If true, the caret will not be moved to the next line automatically after writting to the Console</param>
    ''' <param name="timestamp">If true, a Timestamp will be added to the beggining of the newly inserted line</param>
    ''' <remarks></remarks>
    Public Sub AddLog(ByVal text As String, ByVal leaveOpen As Boolean, ByVal timestamp As Boolean)
        ' Primary AddLog method, All the other ones will end calling this one
        Dim prefix As String = ""
        If timestamp = True Then
            Dim stamp As Date = Now
            Dim component As String
            component = stamp.Hour
            If component.Length = 1 Then component = "0" & component
            prefix = "[" & component & ":"
            component = stamp.Minute
            If component.Length = 1 Then component = "0" & component
            prefix &= component & "] "
        End If

        If (prefix.Length + text.Length) > (Console.BufferWidth - Console.CursorLeft) Then
            ' Text too big
            text = Left(text, Console.BufferWidth - Console.CursorLeft - 3 - prefix.Length)
            text &= "-/>"
            leaveOpen = True
        End If

        If leaveOpen = True Then
            Console.Write(prefix & text)
        Else
            Console.WriteLine(prefix & text)
        End If
    End Sub
    Public Sub AddLog(ByVal text As String, ByVal leaveOpen As Boolean)
        AddLog(text, leaveOpen, EnableTimeStampsByDefault)
    End Sub
    Public Sub AddLog(ByVal text As String)
        AddLog(text, False, EnableTimeStampsByDefault)
    End Sub
    Public Sub AddLog()
        AddLog("", False, False)
    End Sub
    ''' <summary>
    ''' Adds text to the Console Window that will be shown only if the Verbose flag is specified
    ''' </summary>
    ''' <param name="text"></param>
    ''' <remarks></remarks>
    Public Sub AddLogV(ByVal text As String)
        If Verbose = True Then AddLog(text)
    End Sub

    ''' <summary>
    ''' Used to clear the Console output
    ''' </summary>
    ''' <param name="lastLine">If true, only the last line will be cleared</param>
    ''' <remarks></remarks>
    Public Sub ClearLog(ByVal lastLine As Boolean)
        If Console.CursorLeft = 0 Then
            ' At the start of the current line. Move upwards before deleting
            If Not Console.CursorTop = 0 Then Console.CursorTop -= 1
        End If

        ' Position the caret at the start of the current line and delete everything
        Console.CursorLeft = 0
        Dim currLine As Integer = Console.CursorTop
        Dim clearLine As String = StrDup(Console.BufferWidth, " ")
        Console.Write(clearLine)

        ' Reset caret position
        Console.CursorLeft = 0
        Console.CursorTop = currLine
    End Sub
    Public Sub ClearLog()
        ClearLog(False)
    End Sub

    ''' <summary>
    ''' Used to overwrite the last line on the Console window
    ''' </summary>
    ''' <param name="text">Text that will be used to overwrite the last line</param>
    ''' <param name="leaveOpen">If true, the caret will not be moved to the next line automatically after writting to the Console</param>
    ''' <param name="timestamp">If true, a Timestamp will be added to the beggining of the newly inserted line</param>
    ''' <remarks></remarks>
    Public Sub Rewrite(ByVal text As String, ByVal leaveOpen As Boolean, ByVal timestamp As Boolean)
        ClearLog(True)
        AddLog(text, leaveOpen, timestamp)
    End Sub
    Public Sub Rewrite(ByVal text As String, ByVal leaveOpen As Boolean)
        Rewrite(text, leaveOpen, EnableTimeStampsByDefault)
    End Sub
    Public Sub Rewrite(ByVal text As String)
        Rewrite(text, False, EnableTimeStampsByDefault)
    End Sub

    Sub Main()
        AddLog()
        AddLog("APE", False, False)
        AddLog("Arphoon Package Extraction Utility", False, False)
        AddLog("By KDERazorback", False, False)
        AddLog("============================================================", False, False)
        AddLog()
        AddLog("   Utility Version: " & My.Application.Info.Version.ToString, False, False)
        AddLog("   Captain's Journal: " & Now.ToString(System.Globalization.CultureInfo.InvariantCulture), False, False)
        AddLog()
        AddLog()

        Bootstrapping.ProcessCommandLineParameters()

        If PrintHelpOnly Then
            PrintHelp()
            End
        End If

        AddLog("Input package: " & InputFilename)
        AddLog("Extraction Filter: " & OutputFilter)
        AddLog("Recursive: " & RecursiveQuery.ToString())
        AddLog("Output Path: " & OutputPath)
        AddLog()

        ' Check Input file
        Try
            Dim fi As New IO.FileInfo(InputFilename)
            If Not fi.Exists Then
                AddLog("Error!: Specified input package not found.")
                End
            End If

            InputFilename = fi.FullName
        Catch ex As Exception
            AddLog("Error!: Cant open specified input package for reading. Exception.")
            AddLog("    ex: " & ex.Message)
            End
        End Try

        ' Open Package
        Dim engine As New Arps.Engine()
        Dim output As Arps.Engine.PackageMountReturnCode

        AddLog("Mounting package...")

        output = engine.Mount(InputFilename, "")

        If Not output = Arps.Engine.PackageMountReturnCode.MountSuccess Then
            AddLog("Error!: Cant mount specified input package. Returned " & output.ToString())
            End
        End If

        AddLog("Building directory tree...")
        engine.BuildDirectoryTreeStructure()
        AddLog("Building file tree...")
        engine.BuildFileTreeStructure()
        AddLog()

        AddLog("Getting file list...")
        Dim files() As String
        files = engine.FileTree
        Dim fileQueue As New Queue(Of Arps.PackagedFileInformationCollection)()
        Dim i As Long

        Dim filter As String = Trim(LCase(OutputFilter))
        filter = Replace(filter, "\", "/")
        filter = Replace(filter, "//", "/")
        If filter(0) = "/" Then filter = Right(filter, filter.Length - 1)

        For i = 0 To files.Length - 1
            Dim source As String = LCase(files(i))

            source = Replace(source, "\\", "\")
            source = Replace(source, "//", "/")
            source = Replace(source, "\", "/")
            source = Replace(source, "//", "/")
            If source(0) = "/" Then source = Right(source, source.Length - 1)

            If source Like filter Then
                ' Check recursive
                If RecursiveQuery Then
                    fileQueue.Enqueue(engine.GetFile(files(i)))
                Else
                    If Split(source, "/").Length = Split(filter, "/").Length Then
                        fileQueue.Enqueue(engine.GetFile(files(i)))
                    End If
                End If
            End If
        Next

        AddLog("Extracting files...")
        AddLog(fileQueue.Count & " files to extract.")

        If fileQueue.Count < 1 Then End

        Dim reducedOutput As Boolean = (fileQueue.Count > 256)
        Dim totalItems As Long = fileQueue.Count

        If reducedOutput Then AddLog()

        For i = 0 To totalItems
            If fileQueue.Count < 1 Then
                Exit For
            End If

            Dim item As Arps.PackagedFileInformationCollection = fileQueue.Dequeue()

            If reducedOutput Then ClearLog(True)

            AddLog("[" & i & "/" & totalItems & "] " & item.Filename)

            Dim path As String = OutputPath
            path &= "\"
            path &= item.FullName

            path = Replace(path, "/", "\")
            path = Replace(path, "\\", "\")
            path = Replace(path, "?", "_")

            Dim fi As New IO.FileInfo(path)
            path = fi.FullName
            Dim di As IO.DirectoryInfo
            di = fi.Directory
            fi = Nothing
            If Not di.Exists Then di.Create()
            di = Nothing

            Dim fs As New IO.FileStream(path, IO.FileMode.Create, IO.FileAccess.Write, IO.FileShare.None)
            Dim bw As New IO.BinaryWriter(fs)
            Dim ostream As Arps.PackagedFileStream = item.GetStream()

            Do Until ostream.Position >= ostream.Length
                Dim buffer() As Byte

                buffer = ostream.ReadBytes(4096)

                bw.Write(buffer)
            Loop

            bw.Close()
            bw = Nothing
            fs.Dispose()
            fs = Nothing
        Next

        If fileQueue.Count > 0 Then
            AddLog("ERROR!: Application Logic Error. BUG. FileStack is not empty.")
        End If

        If reducedOutput Then ClearLog(True)

        AddLog()
        AddLog("Extraction complete.")
        End
    End Sub

End Module
